home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / lzrtpu.com / SHADETXT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-10-19  |  2.1 KB  |  72 lines
  1. program Shadetxt;
  2.  
  3. Uses
  4. laserprt;
  5. {====================================================================
  6.  Demonstrates how to write shaded text from a Pascal program to an
  7.   HP LaserJet.
  8.  
  9.   Author: Ted Dickens, HP Forum
  10.           Compuserve ID [76701,272]
  11.  
  12. Modified by: Bob Smedley
  13.              72331,3615
  14.  
  15.   Note that area fills progress down and to the right of the current
  16.   cursor location, and that the next character cell to be printed uses
  17.   the current cursor location as the bottom left corner.
  18.  
  19.   Thus we proceed by shading the line before we print on it.  And since
  20.   the text will appear ABOVE the cursor, while shading appears BELOW the
  21.   cursor, we move the cursor UP before executing the shading, then back
  22.   before writing the text.
  23. =======================================================================}
  24.  
  25. CONST
  26. lineheight = 1.0/6.0;              {printing using 6 lines per inch}
  27. linewidth = 8.0;                   {print area is 8"}
  28.  
  29. VAR
  30.    lpt : text;
  31.    i : word;
  32.  
  33. PROCEDURE SetBoxSize(x,y:real);
  34.    BEGIN{setboxsize}
  35.    WRITE(lpt,ShadeWidth(720.0*x)+ShadeHeight(720.0*y));
  36.    END;{setboxsize}
  37.  
  38. PROCEDURE SetShading(p:integer);
  39.    BEGIN{setshading}
  40.    WRITE(lpt,ShadePercent(p));
  41.    END;{setshading}
  42.  
  43. PROCEDURE ShadeFillArea;
  44.    BEGIN{shadefillarea}
  45.    WRITE(lpt,UpY(90.0,decipoints)); {move cursor up 90 decipoints}
  46.    WRITE(lpt,PrintShade);   {shade the line}
  47.    WRITE(lpt,DownY(90.0,decipoints)); {move cursor back to its
  48.                                                original spot}
  49.    END;{shadefillarea}
  50.  
  51. BEGIN{main}
  52. ASSIGN(lpt,'PRN');
  53. REWRITE(lpt);
  54. WRITE(lpt,ResetLaser);       {Reset printer}
  55.                         {note also use of write instead of writeln,
  56.                          this prevents printer buffer from being filled
  57.                          with a LF/CR}
  58.  
  59. SetBoxSize(linewidth,lineheight);
  60. SetShading(20);           {20% shading}
  61.  
  62. FOR i := 1 to 20 DO
  63.    BEGIN
  64.    ShadeFillArea;
  65.    WRITELN(lpt,'This is a shaded line of text.');
  66.    WRITELN(lpt,'This is an unshaded line of text.');
  67.    END;
  68.  
  69. WRITE(lpt,formfeed);            {Eject page}
  70. CLOSE(lpt);
  71. END.
  72.